sdk/samples/all in on code/Visual Studio 2010/VBFTPUpload/FTPClientManager.vb

   1 '*************************** Module Header ******************************'
   2 ' Module Name:  FTPClientManager.vb
   3 ' Project:          VBFTPUpload
   4 ' Copyright (c) Microsoft Corporation.
   5 '
   6 ' The class FTPClientManager supplies following features:
   7 ' 1. Verify whether a file or a directory exists on the FTP server.
   8 ' 2. Delete files or directories on the FTP server.
   9 ' 3. Create a directory on the FTP server.
  10 ' 4. Manage the FTPUploadClient to upload files to the FTP server.
  11 '
  12 '
  13 ' This source is subject to the Microsoft Public License.
  14 ' See http://www.microsoft.com/opensource/licenses.mspx#Ms-PL.
  15 ' All other rights reserved.
  16 '
  17 ' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND,
  18 ' EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED
  19 ' WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
  20 '*************************************************************************'
  21
  22 Imports System.IO
  23 Imports System.Net
  24 Imports System.Linq
  25
  26 Partial Public Class FTPClientManager
  27
  28     ''' <summary>
  29     ''' The Credentials to connect to the FTP server.
  30     ''' </summary>
  31     Public Property Credentials() As ICredentials
  32
  33     ''' <summary>
  34     ''' The current URL of this FTPClient.
  35     ''' </summary>
  36     Private _url As Uri
  37     Public Property Url() As Uri
  38         Get
  39             Return _url
  40         End Get
  41         Private Set(ByVal value As Uri)
  42             _url = value
  43         End Set
  44     End Property
  45
  46     Private _status As FTPClientManagerStatus
  47
  48     ''' <summary>
  49     ''' Get or Set the status of this FTPClient.
  50     ''' </summary>
  51     Public Property Status() As FTPClientManagerStatus
  52         Get
  53             Return _status
  54         End Get
  55
  56         Private Set(ByVal value As FTPClientManagerStatus)
  57             If _status <> value Then
  58                 _status = value
  59
  60                 ' Raise a OnStatusChanged event.
  61                 Me.OnStatusChanged(EventArgs.Empty)
  62
  63             End If
  64         End Set
  65     End Property
  66
  67     Public Event UrlChanged As EventHandler
  68
  69     Public Event ErrorOccurred As EventHandler(Of ErrorEventArgs)
  70
  71     Public Event StatusChanged As EventHandler
  72
  73     Public Event FileUploadCompleted As EventHandler(Of FileUploadCompletedEventArgs)
  74
  75     Public Event NewMessageArrived As EventHandler(Of NewMessageEventArg)
  76
  77     ''' <summary>
  78     '''  Initialize a FTPClient instance.
  79     ''' </summary>
  80     Public Sub New(ByVal url As Uri, ByVal credentials As ICredentials)
  81         Me.Credentials = credentials
  82
  83         ' Check whether the Url exists and the credentials is correct.
  84         ' If there is an error, an exception will be thrown.
  85         CheckFTPUrlExist(url)
  86
  87         Me.Url = url
  88
  89         ' Set the Status.
  90         Me.Status = FTPClientManagerStatus.Idle
  91
  92     End Sub
  93
  94     ''' <summary>
  95     ''' Navigate to the parent folder.
  96     ''' </summary>
  97     Public Sub NavigateParent()
  98         If Url.AbsolutePath <> "/" Then
  99
 100             ' Get the parent url.
 101             Dim newUrl As New Uri(Me.Url, "..")
 102
 103             ' Check whether the Url exists.
 104             CheckFTPUrlExist(newUrl)
 105
 106             Me.Url = newUrl
 107             Me.OnUrlChanged(EventArgs.Empty)
 108         End If
 109     End Sub
 110
 111     ''' <summary>
 112     ''' Navigate a url.
 113     ''' </summary>
 114     Public Sub Naviagte(ByVal newUrl As Uri)
 115         ' Check whether the Url exists.
 116         Dim urlExist As Boolean = VerifyFTPUrlExist(newUrl)
 117
 118         Me.Url = newUrl
 119         Me.OnUrlChanged(EventArgs.Empty)
 120     End Sub
 121
 122     ''' <summary>
 123     ''' If the Url does not exist, an exception will be thrown.
 124     ''' </summary>
 125     Private Sub CheckFTPUrlExist(ByVal url As Uri)
 126         Dim urlExist As Boolean = VerifyFTPUrlExist(url)
 127
 128         If Not urlExist Then
 129             Throw New ApplicationException("The url does not exist")
 130         End If
 131     End Sub
 132
 133     ''' <summary>
 134     ''' Verify whether the url exists.
 135     ''' </summary>
 136     Private Function VerifyFTPUrlExist(ByVal url As Uri) As Boolean
 137         Dim urlExist As Boolean = False
 138
 139         If url.IsFile Then
 140             urlExist = VerifyFileExist(url)
 141         Else
 142             urlExist = VerifyDirectoryExist(url)
 143         End If
 144
 145         Return urlExist
 146     End Function
 147
 148     ''' <summary>
 149     ''' Verify whether the directory exists.
 150     ''' </summary>
 151     Private Function VerifyDirectoryExist(ByVal url As Uri) As Boolean
 152         Dim request As FtpWebRequest = TryCast(WebRequest.Create(url), FtpWebRequest)
 153         request.Credentials = Me.Credentials
 154         request.Method = WebRequestMethods.Ftp.ListDirectory
 155
 156         Dim response As FtpWebResponse = Nothing
 157
 158         Try
 159             response = TryCast(request.GetResponse(), FtpWebResponse)
 160
 161             Return response.StatusCode = FtpStatusCode.DataAlreadyOpen
 162         Catch webEx As System.Net.WebException
 163             Dim ftpResponse As FtpWebResponse = TryCast(webEx.Response, FtpWebResponse)
 164
 165             If ftpResponse.StatusCode = FtpStatusCode.ActionNotTakenFileUnavailable Then
 166                 Return False
 167             End If
 168
 169             Throw
 170         Finally
 171             If response IsNot Nothing Then
 172                 response.Close()
 173             End If
 174         End Try
 175     End Function
 176
 177     ''' <summary>
 178     ''' Verify whether the file exists.
 179     ''' </summary>
 180     Private Function VerifyFileExist(ByVal url As Uri) As Boolean
 181         Dim request As FtpWebRequest = TryCast(WebRequest.Create(url), FtpWebRequest)
 182         request.Credentials = Me.Credentials
 183         request.Method = WebRequestMethods.Ftp.GetFileSize
 184
 185         Dim response As FtpWebResponse = Nothing
 186
 187         Try
 188             response = TryCast(request.GetResponse(), FtpWebResponse)
 189
 190             Return response.StatusCode = FtpStatusCode.FileStatus
 191         Catch webEx As System.Net.WebException
 192             Dim ftpResponse As FtpWebResponse = TryCast(webEx.Response, FtpWebResponse)
 193
 194             If ftpResponse.StatusCode = FtpStatusCode.ActionNotTakenFileUnavailable Then
 195                 Return False
 196             End If
 197
 198             Throw
 199         Finally
 200             If response IsNot Nothing Then
 201                 response.Close()
 202             End If
 203         End Try
 204     End Function
 205
 206     ''' <summary>
 207     ''' Get the sub directories and files of the current Url by default.
 208     ''' </summary>
 209     Public Function GetSubDirectoriesAndFiles() As IEnumerable(Of FTPFileSystem)
 210         Return GetSubDirectoriesAndFiles(Me.Url)
 211     End Function
 212
 213     ''' <summary>
 214     ''' Get the sub directories and files of the Url. It will be used in enumerate
 215     ''' all the folders.
 216     ''' When run the FTP LIST protocol method to get a detailed listing of the files
 217     ''' on an FTP server, the server will response many records of information. Each
 218     ''' record represents a file.
 219     ''' </summary>
 220     Public Function GetSubDirectoriesAndFiles(ByVal url As Uri) _
 221         As IEnumerable(Of FTPFileSystem)
 222         Dim request As FtpWebRequest = TryCast(WebRequest.Create(url), FtpWebRequest)
 223         request.Credentials = Me.Credentials
 224         request.Method = WebRequestMethods.Ftp.ListDirectoryDetails
 225
 226         Dim response As FtpWebResponse = Nothing
 227         Dim responseStream As Stream = Nothing
 228         Dim reader As StreamReader = Nothing
 229         Try
 230             response = TryCast(request.GetResponse(), FtpWebResponse)
 231
 232             Me.OnNewMessageArrived(New NewMessageEventArg _
 233                                    With {.NewMessage = response.StatusDescription})
 234
 235                 responseStream = response.GetResponseStream()
 236                 reader = New StreamReader(responseStream)
 237
 238                 Dim subDirs As New List(Of FTPFileSystem)()
 239
 240                 Dim subDir As String = reader.ReadLine()
 241
 242                 ' Find out the FTP Directory Listing Style from the recordString.
 243                 Dim style As FTPDirectoryListingStyle = FTPDirectoryListingStyle.MSDOS
 244                 If Not String.IsNullOrEmpty(subDir) Then
 245                     style = FTPFileSystem.GetDirectoryListingStyle(subDir)
 246                 End If
 247                 Do While Not String.IsNullOrEmpty(subDir)
 248                     subDirs.Add(FTPFileSystem.ParseRecordString(url, subDir, style))
 249
 250                     subDir = reader.ReadLine()
 251                 Loop
 252                 Return subDirs
 253         Finally
 254             If response IsNot Nothing Then
 255                 response.Close()
 256             End If
 257
 258             ' Close the StreamReader object and the underlying stream, and release
 259             ' any system resources associated with the reader.
 260             If reader IsNot Nothing Then
 261                 reader.Close()
 262             End If
 263         End Try
 264     End Function
 265
 266     ''' <summary>
 267     ''' Create a sub directory of a folder on the remote FTP server.
 268     ''' </summary>
 269     Public Sub CreateDirectoryOnFTPServer(ByVal serverPath As Uri,
 270                                           ByVal subDirectoryName As String)
 271
 272         ' Create the Url for the new sub directory.
 273         Dim subDirUrl As New Uri(serverPath, subDirectoryName)
 274
 275         ' Check whether sub directory exist.
 276         Dim urlExist As Boolean = VerifyFTPUrlExist(subDirUrl)
 277
 278         If urlExist Then
 279             Return
 280         End If
 281
 282         Try
 283             ' Create an FtpWebRequest to create the sub directory.
 284             Dim request As FtpWebRequest = TryCast(WebRequest.Create(subDirUrl),
 285                 FtpWebRequest)
 286             request.Credentials = Me.Credentials
 287             request.Method = WebRequestMethods.Ftp.MakeDirectory
 288
 289             Using response As FtpWebResponse = TryCast(request.GetResponse(),
 290                 FtpWebResponse)
 291                 Me.OnNewMessageArrived(New NewMessageEventArg _
 292                                        With {.NewMessage = response.StatusDescription})
 293             End Using
 294
 295             ' If the folder does not exist, create the folder.
 296         Catch webEx As System.Net.WebException
 297
 298             Dim ftpResponse As FtpWebResponse = TryCast(webEx.Response, FtpWebResponse)
 299
 300             Dim msg As String = String.Format(
 301                 "There is an error while creating folder {0}. " _
 302                 & " StatusCode: {1}  StatusDescription: {2} ",
 303                 subDirUrl.ToString(),
 304                 ftpResponse.StatusCode.ToString(),
 305                 ftpResponse.StatusDescription)
 306             Dim errorException As New ApplicationException(msg, webEx)
 307
 308             ' Fire the ErrorOccurred event with the error.
 309             Dim e As ErrorEventArgs = New ErrorEventArgs _
 310                                       With {.ErrorException = errorException}
 311
 312             Me.OnErrorOccurred(e)
 313         End Try
 314     End Sub
 315
 316     ''' <summary>
 317     ''' Delete items on FTP server.
 318     ''' </summary>
 319     Public Sub DeleteItemsOnFTPServer(ByVal fileSystems As IEnumerable(Of FTPFileSystem))
 320         If fileSystems Is Nothing Then
 321             Throw New ArgumentException("The item to delete is null!")
 322         End If
 323
 324         For Each fileSystem In fileSystems
 325             DeleteItemOnFTPServer(fileSystem)
 326         Next fileSystem
 327
 328     End Sub
 329
 330     ''' <summary>
 331     ''' Delete an item on FTP server.
 332     ''' </summary>
 333     Public Sub DeleteItemOnFTPServer(ByVal fileSystem As FTPFileSystem)
 334         ' Check whether sub directory exist.
 335         Dim urlExist As Boolean = VerifyFTPUrlExist(fileSystem.Url)
 336
 337         If Not urlExist Then
 338             Return
 339         End If
 340
 341         Try
 342
 343             ' Non-Empty folder cannot be deleted.
 344             If fileSystem.IsDirectory Then
 345                 Dim subFTPFiles = GetSubDirectoriesAndFiles(fileSystem.Url)
 346
 347                 DeleteItemsOnFTPServer(subFTPFiles)
 348             End If
 349
 350             ' Create an FtpWebRequest to create the sub directory.
 351             Dim request As FtpWebRequest = TryCast(WebRequest.Create(fileSystem.Url),
 352                 FtpWebRequest)
 353             request.Credentials = Me.Credentials
 354
 355             request.Method = If(fileSystem.IsDirectory,
 356                                 WebRequestMethods.Ftp.RemoveDirectory,
 357                                 WebRequestMethods.Ftp.DeleteFile)
 358
 359             Using response As FtpWebResponse = TryCast(request.GetResponse(),
 360                 FtpWebResponse)
 361                 Me.OnNewMessageArrived(New NewMessageEventArg _
 362                                        With {.NewMessage = response.StatusDescription})
 363             End Using
 364         Catch webEx As System.Net.WebException
 365             Dim ftpResponse As FtpWebResponse = TryCast(webEx.Response, FtpWebResponse)
 366
 367             Dim msg As String = String.Format(
 368                 "There is an error while deleting {0}. " _
 369                 & " StatusCode: {1}  StatusDescription: {2} ",
 370                 fileSystem.Url.ToString(),
 371                 ftpResponse.StatusCode.ToString(),
 372                 ftpResponse.StatusDescription)
 373             Dim errorException As New ApplicationException(msg, webEx)
 374
 375             ' Fire the ErrorOccurred event with the error.
 376             Dim e As ErrorEventArgs = New ErrorEventArgs _
 377                                       With {.ErrorException = errorException}
 378
 379             Me.OnErrorOccurred(e)
 380         End Try
 381     End Sub
 382
 383     ''' <summary>
 384     ''' Upload a whole local folder to FTP server.
 385     ''' </summary>
 386     Public Sub UploadFolder(ByVal localFolder As DirectoryInfo,
 387                             ByVal serverPath As Uri, ByVal createFolderOnServer As Boolean)
 388         ' The method UploadFoldersAndFiles will create or override a folder by default.
 389         If createFolderOnServer Then
 390             UploadFoldersAndFiles(New FileSystemInfo() {localFolder}, serverPath)
 391
 392             ' Upload the files and sub directories of the local folder.
 393         Else
 394             UploadFoldersAndFiles(localFolder.GetFileSystemInfos(), serverPath)
 395         End If
 396     End Sub
 397
 398     ''' <summary>
 399     ''' Upload local folders and files to FTP server.
 400     ''' </summary>
 401     Public Sub UploadFoldersAndFiles(ByVal fileSystemInfos As IEnumerable(Of FileSystemInfo),
 402                                      ByVal serverPath As Uri)
 403         If Me._status <> FTPClientManagerStatus.Idle Then
 404             Throw New ApplicationException("This client is busy now.")
 405         End If
 406
 407         Me.Status = FTPClientManagerStatus.Uploading
 408
 409         Dim uploadClient As New FTPUploadClient(Me)
 410
 411         ' Register the events.
 412         AddHandler uploadClient.AllFilesUploadCompleted,
 413             AddressOf uploadClient_AllFilesUploadCompleted
 414         AddHandler uploadClient.FileUploadCompleted,
 415             AddressOf uploadClient_FileUploadCompleted
 416
 417         uploadClient.UploadDirectoriesAndFiles(fileSystemInfos, serverPath)
 418     End Sub
 419
 420
 421     Private Sub uploadClient_FileUploadCompleted(ByVal sender As Object,
 422                                                  ByVal e As FileUploadCompletedEventArgs)
 423         Me.OnFileUploadCompleted(e)
 424     End Sub
 425
 426     Private Sub uploadClient_AllFilesUploadCompleted(ByVal sender As Object,
 427                                                      ByVal e As EventArgs)
 428         Me.Status = FTPClientManagerStatus.Idle
 429     End Sub
 430
 431     Protected Overridable Sub OnUrlChanged(ByVal e As EventArgs)
 432         RaiseEvent UrlChanged(Me, e)
 433     End Sub
 434
 435     Protected Overridable Sub OnStatusChanged(ByVal e As EventArgs)
 436         RaiseEvent StatusChanged(Me, e)
 437     End Sub
 438
 439     Protected Overridable Sub OnFileUploadCompleted(ByVal e As FileUploadCompletedEventArgs)
 440         RaiseEvent FileUploadCompleted(Me, e)
 441     End Sub
 442
 443     Protected Overridable Sub OnErrorOccurred(ByVal e As ErrorEventArgs)
 444         Me.Status = FTPClientManagerStatus.Idle
 445
 446         RaiseEvent ErrorOccurred(Me, e)
 447     End Sub
 448
 449     Protected Overridable Sub OnNewMessageArrived(ByVal e As NewMessageEventArg)
 450         RaiseEvent NewMessageArrived(Me, e)
 451     End Sub
 452 End Class